{ *************************************************************************** }

 { Audio Tools Library                                                         }
 { Class TFLACfile - for manipulating with FLAC file information               }

 { http://mac.sourceforge.net/atl/                                             }
 { e-mail: macteam@users.sourceforge.net                                       }

 { Copyright (c) 2000-2002 by Jurgen Faul                                      }
 { Copyright (c) 2003-2005 by The MAC Team                                     }

 { Version 1.4 (April 2005) by Gambit                                          }
 {   - updated to unicode file access                                          }

 { Version 1.3 (13 August 2004) by jtclipper                                   }
 {   - unit rewritten, VorbisComment is obsolete now                           }

 { Version 1.2 (23 June 2004) by sundance                                      }
 {   - Check for ID3 tags (although not supported)                             }
 {   - Don't parse for other FLAC metablocks if FLAC header is missing         }

 { Version 1.1 (6 July 2003) by Erik                                           }
 {   - Class: Vorbis comments (native comment to FLAC files) added             }

 { Version 1.0 (13 August 2002)                                                }
 {   - Info: channels, sample rate, bits/sample, file size, duration, ratio    }
 {   - Class TID3v1: reading & writing support for ID3v1 tags                  }
 {   - Class TID3v2: reading & writing support for ID3v2 tags                  }

 { This library is free software; you can redistribute it and/or               }
 { modify it under the terms of the GNU Lesser General Public                  }
 { License as published by the Free Software Foundation; either                }
 { version 2.1 of the License, or (at your option) any later version.          }

 { This library is distributed in the hope that it will be useful,             }
 { but WITHOUT ANY WARRANTY; without even the implied warranty of              }
 { MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU           }
 { Lesser General Public License for more details.                             }

 { You should have received a copy of the GNU Lesser General Public            }
 { License along with this library; if not, write to the Free Software         }
 { Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA   }

{ *************************************************************************** }

unit FLACfile;

interface

uses
  Classes, SysUtils, StrUtils, ID3v2, CommonATL;

const
  META_STREAMINFO  = 0;
  META_PADDING     = 1;
  META_APPLICATION = 2;
  META_SEEKTABLE   = 3;
  META_VORBIS_COMMENT = 4;
  META_CUESHEET    = 5;

type
  TFlacHeader = record
    StreamMarker: array[1..4] of char; //should always be 'fLaC'
    MetaDataBlockHeader: array[1..4] of byte;
    Info:   array[1..18] of byte;
    MD5Sum: array[1..16] of byte;
  end;

  TMetaData = record
    MetaDataBlockHeader: array[1..4] of byte;
    Data: TMemoryStream;
  end;


  TFLACfile = class (TObject)
  private

    FHeader:      TFlacHeader;
    FFileName:    WideString;
    FPaddingIndex: integer;
    FPaddingLast: boolean;
    FPaddingFragments: boolean;
    FVorbisIndex: integer;
    FPadding:     integer;
    FVCOffset:    integer;
    FAudioOffset: integer;
    FChannels:    byte;
    FSampleRate:  integer;
    FBitsPerSample: byte;
    FBitrate:     integer;
    FFileLength:  integer;
    FSamples:     int64;

    aMetaBlockOther: array of TMetaData;

    // tag data
    FVendor:  string;
    FTagSize: integer;
    FExists:  boolean;

    FID3v2: TID3v2;

    function FGetHasLyrics: boolean;

    procedure FResetData(const bHeaderInfo, bTagFields: boolean);
    function FIsValid: boolean;
    function FGetDuration: double;
    function FGetRatio: double;
    function FGetChannelMode: string;

    function GetInfo(sFile: WideString; bSetTags: boolean): boolean;
    procedure AddMetaDataOther(aMetaHeader: array of byte; stream: TFileStream;
      const iBlocklength, iIndex: integer);
    procedure ReadTag(Source: TFileStream; bSetTagFields: boolean);
    function RebuildFile(const sFile: WideString; VorbisBlock: TStringStream): boolean;

    function DecodeUTF8(const Source: string): WideString;
    function EncodeUTF8(const Source: WideString): string;

  public

    TrackString: string;
    Title:    string;
    Artist:   string;
    Album:    string;
    Year:     string;
    Genre:    string;
    Comment:  string;
    //extra
    xTones:   string;
    xStyles:  string;
    xMood:    string;
    xSituation: string;
    xRating:  string;
    xQuality: string;
    xTempo:   string;
    xType:    string;


    Composer:  string;
    Language:  string;
    Copyright: string;
    Link:      string;
    Encoder:   string;
    Lyrics:    string;
    Performer: string;
    License:   string;
    Organization: string;
    Description: string;
    Location:  string;
    Contact:   string;
    ISRC:      string;
    aExtraFields: array of array of string;

    constructor Create;
    destructor Destroy; override;

    function ReadFromFile(const sFile: WideString): boolean;
    function SaveToFile(const sFile: WideString;
      const bBasicOnly: boolean = False): boolean;
    function RemoveFromFile(const sFile: WideString): boolean;
    procedure AddExtraField(const sID, sValue: string);

    property Channels: byte Read FChannels;                     // Number of channels
    property SampleRate: integer Read FSampleRate;              // Sample rate (hz)
    property BitsPerSample: byte Read FBitsPerSample;           // Bits per sample
    property FileLength: integer Read FFileLength;              // File length (bytes)
    property Samples: int64 Read FSamples;                      // Number of samples
    property Valid: boolean Read FIsValid;                      // True if header valid
    property Duration: double Read FGetDuration;                // Duration (seconds)
    property Ratio: double Read FGetRatio;                      // Compression ratio (%)
    property Bitrate: integer Read FBitrate;
    property ChannelMode: string Read FGetChannelMode;
    property Exists: boolean Read FExists;
    property Vendor: string Read FVendor;
    property FileName: WideString Read FFileName;
    property AudioOffset: integer Read FAudioOffset;           //offset of audio data
    property HasLyrics: boolean Read FGetHasLyrics;
  end;

var
  bTAG_PreserveDate: boolean;


implementation

(* -------------------------------------------------------------------------- *)

procedure TFLACfile.FResetData(const bHeaderInfo, bTagFields: boolean);
var
  i: integer;
begin

  if bHeaderInfo then
    begin
    FFileName     := '';
    FPadding      := 0;
    FPaddingLast  := False;
    FPaddingFragments := False;
    FChannels     := 0;
    FSampleRate   := 0;
    FBitsPerSample := 0;
    FFileLength   := 0;
    FSamples      := 0;
    FVorbisIndex  := 0;
    FPaddingIndex := 0;
    FVCOffset     := 0;
    FAudioOffset  := 0;

    for i := 0 to Length(aMetaBlockOther) - 1 do
      aMetaBlockOther[i].Data.Free;
    SetLength(aMetaBlockOther, 0);
    end;

  //tag data
  if bTagFields then
    begin
    FVendor  := '';
    FTagSize := 0;
    FExists  := False;

    Title    := '';
    Artist   := '';
    Album    := '';
    TrackString := '';
    Year     := '';
    Genre    := '';
    Comment  := '';
    //extra
    xTones   := '';
    xStyles  := '';
    xMood    := '';
    xSituation := '';
    xRating  := '';
    xQuality := '';
    xTempo   := '';
    xType    := '';


    Composer  := '';
    Language  := '';
    Copyright := '';
    Link      := '';
    Encoder   := '';
    Lyrics    := '';
    Performer := '';
    License   := '';
    Organization := '';
    Description := '';
    Location  := '';
    Contact   := '';
    ISRC      := '';
    SetLength(aExtraFields, 0);
    end;
end;

 (* -------------------------------------------------------------------------- *)
 // Check for right FLAC file data
function TFLACfile.FIsValid: boolean;
begin
  Result := (FHeader.StreamMarker = 'fLaC') and (FChannels > 0) and
    (FSampleRate > 0) and (FBitsPerSample > 0) and (FSamples > 0);
end;

(* -------------------------------------------------------------------------- *)

function TFLACfile.FGetDuration: double;
begin
  if (FIsValid) and (FSampleRate > 0) then
    begin
    Result := FSamples / FSampleRate;
    end
  else
    begin
    Result := 0;
    end;
end;

 (* -------------------------------------------------------------------------- *)
 //   Get compression ratio
function TFLACfile.FGetRatio: double;
begin
  if FIsValid then
    begin
    Result := FFileLength / (FSamples * FChannels * FBitsPerSample / 8) * 100;
    end
  else
    begin
    Result := 0;
    end;
end;

 (* -------------------------------------------------------------------------- *)
 //   Get channel mode
function TFLACfile.FGetChannelMode: string;
begin
  if FIsValid then
    begin
    case FChannels of
      1:
        Result := 'Mono';
      2:
        Result := 'Stereo';
      else
        Result := 'Multi Channel';
      end;
    end
  else
    begin
    Result := '';
    end;
end;

(* -------------------------------------------------------------------------- *)

function TFLACfile.FGetHasLyrics: boolean;
begin
  Result := (Trim(Lyrics) <> '');
end;

(* -------------------------------------------------------------------------- *)

constructor TFLACfile.Create;
begin
  inherited;
  FID3v2 := TID3v2.Create;
  FResetData(True, True);
end;

destructor TFLACfile.Destroy;
begin
  FResetData(True, True);
  FID3v2.Free;
  inherited;
end;

(* -------------------------------------------------------------------------- *)

function TFLACfile.ReadFromFile(const sFile: WideString): boolean;
begin
  FResetData(False, True);
  Result := GetInfo(sFile, True);
end;

(* -------------------------------------------------------------------------- *)

function TFLACfile.GetInfo(sFile: WideString; bSetTags: boolean): boolean;
var
  SourceFile:    TFileStream;
  aMetaDataBlockHeader: array[1..4] of byte;
  iBlockLength, iMetaType, iIndex: integer;
  bPaddingFound: boolean;
begin

  Result := True;
  bPaddingFound := False;
  FResetData(True, False);
  try
    { Read data from ID3 tags }
    FID3v2.ReadFromFile(sFile);

    // Set read-access and open file
    SourceFile  := TFileStream.Create(sFile, fmOpenRead or fmShareDenyWrite);
    FFileLength := SourceFile.Size;
    FFileName   := sFile;

    { Seek past the ID3v2 tag, if there is one }
    if FID3v2.Exists then
      begin
      SourceFile.Seek(FID3v2.Size, soFromBeginning);
      end;

    // Read header data
    FillChar(FHeader, SizeOf(FHeader), 0);
    SourceFile.Read(FHeader, SizeOf(FHeader));

    // Process data if loaded and header valid
    if FHeader.StreamMarker = 'fLaC' then
      begin

      with FHeader do
        begin
        FChannels := (Info[13] shr 1 and $7 + 1);
        FSampleRate := (Info[11] shl 12 or Info[12] shl 4 or Info[13] shr 4);
        FBitsPerSample := (Info[13] and 1 shl 4 or Info[14] shr 4 + 1);
        FSamples := (Info[15] shl 24 or Info[16] shl 16 or Info[17] shl
          8 or Info[18]);
        end;

      if (FHeader.MetaDataBlockHeader[1] and $80) <> 0 then
        exit; //no metadata blocks exist
      iIndex := 0;
      repeat // read more metadata blocks if available

        SourceFile.Read(aMetaDataBlockHeader, 4);

        iIndex := iIndex + 1; // metadatablock index
        iBlockLength := (aMetaDataBlockHeader[2] shl 16 or
          aMetaDataBlockHeader[3] shl 8 or aMetaDataBlockHeader[4]); //decode length
        if iBlockLength <= 0 then
          exit; // can it be 0 ?

        iMetaType := (aMetaDataBlockHeader[1] and $7F); // decode metablock type

        if iMetaType = META_VORBIS_COMMENT then
          begin  // read vorbis block
          FVCOffset    := SourceFile.Position;
          FTagSize     := iBlockLength;
          FVorbisIndex := iIndex;
          ReadTag(SourceFile, bSetTags); // set up fields
          end
        else
        if (iMetaType = META_PADDING) and not bPaddingFound then
          begin // we have padding block
          FPadding      := iBlockLength;
          // if we find more skip & put them in metablock array
          FPaddingLast  := ((aMetaDataBlockHeader[1] and $80) <> 0);
          FPaddingIndex := iIndex;
          bPaddingFound := True;
          SourceFile.Seek(FPadding, soCurrent);
          // advance into file till next block or audio data start
          end
        else
          begin // all other
          if iMetaType <= 5 then
            begin // is it a valid metablock ?
            if (iMetaType = META_PADDING) then
              begin // set flag for fragmented padding blocks
              FPaddingFragments := True;
              end;
            AddMetaDataOther(aMetaDataBlockHeader, SourceFile, iBlocklength, iIndex);
            end
          else
            begin
            FSamples := 0; //ops...
            exit;
            end;
          end;

      until ((aMetaDataBlockHeader[1] and $80) <> 0);
      // until is last flag ( first bit = 1 )

      end;
  finally
    if FIsValid then
      begin
      FAudioOffset := SourceFile.Position;
      // we need that to rebuild the file if nedeed
      FBitrate     := Round(((FFileLength - FAudioOffset) / 1000) * 8 / FGetDuration);
      //time to calculate average bitrate
      end
    else
      begin
      Result := False;
      end;
    FreeAndNil(SourceFile);
    end;

end;

(* -------------------------------------------------------------------------- *)

procedure TFLACfile.AddMetaDataOther(aMetaHeader: array of byte;
  stream: TFileStream; const iBlocklength, iIndex: integer);
var
  iMetaLen: integer;
begin
  // enlarge array
  iMetaLen := Length(aMetaBlockOther) + 1;
  SetLength(aMetaBlockOther, iMetaLen);
  // save header
  aMetaBlockOther[iMetaLen - 1].MetaDataBlockHeader[1] := aMetaHeader[0];
  aMetaBlockOther[iMetaLen - 1].MetaDataBlockHeader[2] := aMetaHeader[1];
  aMetaBlockOther[iMetaLen - 1].MetaDataBlockHeader[3] := aMetaHeader[2];
  aMetaBlockOther[iMetaLen - 1].MetaDataBlockHeader[4] := aMetaHeader[3];
  // save content in a stream
  aMetaBlockOther[iMetaLen - 1].Data := TMemoryStream.Create;
  aMetaBlockOther[iMetaLen - 1].Data.Position := 0;
  aMetaBlockOther[iMetaLen - 1].Data.CopyFrom(stream, iBlocklength);
end;

(* -------------------------------------------------------------------------- *)

procedure TFLACfile.ReadTag(Source: TFileStream; bSetTagFields: boolean);
var
  i, iCount, iSize, iSepPos: integer;
  Data: array of char;
  sFieldID, sFieldData: string;
begin

  Source.Read(iSize, SizeOf(iSize)); // vendor
  SetLength(Data, iSize);
  Source.Read(Data[0], iSize);
  FVendor := string(Data);

  Source.Read(iCount, SizeOf(iCount)); //fieldcount

  FExists := (iCount > 0);

  for i := 0 to iCount - 1 do
    begin
    Source.Read(iSize, SizeOf(iSize));
    SetLength(Data, iSize);
    Source.Read(Data[0], iSize);

    if not bSetTagFields then
      Continue; // if we don't want to re asign fields we skip

    iSepPos := Pos('=', string(Data));
    if iSepPos > 0 then
      begin

      sFieldID   := UpperCase(Copy(string(Data), 1, iSepPos - 1));
      sFieldData := DecodeUTF8(Copy(string(Data), iSepPos + 1, MaxInt));

      if (sFieldID = 'TRACKNUMBER') and (TrackString = '') then
        begin
        TrackString := sFieldData;
        end
      else
      if (sFieldID = 'ARTIST') and (Artist = '') then
        begin
        Artist := sFieldData;
        end
      else
      if (sFieldID = 'ALBUM') and (Album = '') then
        begin
        Album := sFieldData;
        end
      else
      if (sFieldID = 'TITLE') and (Title = '') then
        begin
        Title := sFieldData;
        end
      else
      if (sFieldID = 'DATE') and (Year = '') then
        begin
        Year := sFieldData;
        end
      else
      if (sFieldID = 'GENRE') and (Genre = '') then
        begin
        Genre := sFieldData;
        end
      else
      if (sFieldID = 'COMMENT') and (Comment = '') then
        begin
        Comment := sFieldData;
        end
      else
      if (sFieldID = 'COMPOSER') and (Composer = '') then
        begin
        Composer := sFieldData;
        end
      else
      if (sFieldID = 'LANGUAGE') and (Language = '') then
        begin
        Language := sFieldData;
        end
      else
      if (sFieldID = 'COPYRIGHT') and (Copyright = '') then
        begin
        Copyright := sFieldData;
        end
      else
      if (sFieldID = 'URL') and (Link = '') then
        begin
        Link := sFieldData;
        end
      else
      if (sFieldID = 'ENCODER') and (Encoder = '') then
        begin
        Encoder := sFieldData;
        end
      else
      if (sFieldID = 'TONES') and (xTones = '') then
        begin
        xTones := sFieldData;
        end
      else
      if (sFieldID = 'STYLES') and (xStyles = '') then
        begin
        xStyles := sFieldData;
        end
      else
      if (sFieldID = 'MOOD') and (xMood = '') then
        begin
        xMood := sFieldData;
        end
      else
      if (sFieldID = 'SITUATION') and (xSituation = '') then
        begin
        xSituation := sFieldData;
        end
      else
      if (sFieldID = 'RATING') and (xRating = '') then
        begin
        xRating := sFieldData;
        end
      else
      if (sFieldID = 'QUALITY') and (xQuality = '') then
        begin
        xQuality := sFieldData;
        end
      else
      if (sFieldID = 'TEMPO') and (xTempo = '') then
        begin
        xTempo := sFieldData;
        end
      else
      if (sFieldID = 'TYPE') and (xType = '') then
        begin
        xType := sFieldData;
        end
      else
      if (sFieldID = 'LYRICS') and (Lyrics = '') then
        begin
        Lyrics := sFieldData;
        end
      else
      if (sFieldID = 'PERFORMER') and (Performer = '') then
        begin
        Performer := sFieldData;
        end
      else
      if (sFieldID = 'LICENSE') and (License = '') then
        begin
        License := sFieldData;
        end
      else
      if (sFieldID = 'ORGANIZATION') and (Organization = '') then
        begin
        Organization := sFieldData;
        end
      else
      if (sFieldID = 'DESCRIPTION') and (Description = '') then
        begin
        Description := sFieldData;
        end
      else
      if (sFieldID = 'LOCATION') and (Location = '') then
        begin
        Location := sFieldData;
        end
      else
      if (sFieldID = 'CONTACT') and (Contact = '') then
        begin
        Contact := sFieldData;
        end
      else
      if (sFieldID = 'ISRC') and (ISRC = '') then
        begin
        ISRC := sFieldData;
        end
      else
        begin // more fields
        AddExtraField(sFieldID, sFieldData);
        end;

      end;

    end;

end;

(* -------------------------------------------------------------------------- *)

procedure TFLACfile.AddExtraField(const sID, sValue: string);
var
  iExtraLen: integer;
begin
  iExtraLen := Length(aExtraFields) + 1;
  SetLength(aExtraFields, iExtraLen);
  SetLength(aExtraFields[iExtraLen - 1], 2);

  aExtraFields[iExtraLen - 1, 0] := sID;
  aExtraFields[iExtraLen - 1, 1] := sValue;
end;

(* -------------------------------------------------------------------------- *)

function TFLACfile.SaveToFile(const sFile: WideString;
  const bBasicOnly: boolean = False): boolean;
var
  i, iFieldCount, iSize: integer;
  VorbisBlock, Tag:      TStringStream;

  procedure _WriteTagBuff(sID, sData: string);
  var
    sTmp: string;
    iTmp: integer;
  begin
    if sData <> '' then
      begin
      sTmp := sID + '=' + EncodeUTF8(sData);
      iTmp := Length(sTmp);
      Tag.Write(iTmp, SizeOf(iTmp));
      Tag.WriteString(sTmp);
      iFieldCount := iFieldCount + 1;
      end;
  end;

begin

  try
    Result := False;

    Tag := TStringStream.Create('');
    VorbisBlock := TStringStream.Create('');
    if not GetInfo(sFile, False) then
      exit; //reload all except tag fields

    iFieldCount := 0;

    _WriteTagBuff('TRACKNUMBER', TrackString);
    _WriteTagBuff('ARTIST', Artist);
    _WriteTagBuff('ALBUM', Album);
    _WriteTagBuff('TITLE', Title);
    _WriteTagBuff('DATE', Year);
    _WriteTagBuff('GENRE', Genre);
    _WriteTagBuff('COMMENT', Comment);
    _WriteTagBuff('COMPOSER', Composer);
    _WriteTagBuff('LANGUAGE', Language);
    _WriteTagBuff('COPYRIGHT', Copyright);
    _WriteTagBuff('URL', Link);
    _WriteTagBuff('ENCODER', Encoder);

    _WriteTagBuff('TONES', xTones);
    _WriteTagBuff('STYLES', xStyles);
    _WriteTagBuff('MOOD', xMood);
    _WriteTagBuff('SITUATION', xSituation);
    _WriteTagBuff('RATING', xRating);
    _WriteTagBuff('QUALITY', xQuality);
    _WriteTagBuff('TEMPO', xTempo);
    _WriteTagBuff('TYPE', xType);

    if not bBasicOnly then
      begin
      _WriteTagBuff('PERFORMER', Performer);
      _WriteTagBuff('LICENSE', License);
      _WriteTagBuff('ORGANIZATION', Organization);
      _WriteTagBuff('DESCRIPTION', Description);
      _WriteTagBuff('LOCATION', Location);
      _WriteTagBuff('CONTACT', Contact);
      _WriteTagBuff('ISRC', ISRC);
      _WriteTagBuff('LYRICS', Lyrics);

      for i := 0 to Length(aExtraFields) - 1 do
        begin
        if Trim(aExtraFields[i, 0]) <> '' then
          _WriteTagBuff(aExtraFields[i, 0], aExtraFields[i, 1]);
        end;
      end;

    // Write vendor info and number of fields
    with VorbisBlock do
      begin
      if FVendor = '' then
        FVendor := 'reference libFLAC 1.1.0 20030126'; // guess it
      iSize := Length(FVendor);
      Write(iSize, SizeOf(iSize));
      WriteString(FVendor);
      Write(iFieldCount, SizeOf(iFieldCount));
      end;

    VorbisBlock.CopyFrom(Tag, 0); // All tag data is here now
    VorbisBlock.Position := 0;

    Result  := RebuildFile(sFile, VorbisBlock);
    FExists := Result and (Tag.Size > 0);

  finally
    FreeAndNil(Tag);
    FreeAndNil(VorbisBlock);
    end;

end;

(* -------------------------------------------------------------------------- *)

function TFLACfile.RemoveFromFile(const sFile: WideString): boolean;
begin
  FResetData(False, True);
  Result := SaveToFile(sFile);
  if FExists then
    FExists := not Result;
end;

 (* -------------------------------------------------------------------------- *)
 // saves metablocks back to the file
// always tries to rebuild header so padding exists after comment block and no more than 1 padding block exists
function TFLACfile.RebuildFile(const sFile: WideString;
  VorbisBlock: TStringStream): boolean;
var
  Source, Destination: TFileStream;
  i, iFileAge, iNewPadding, iMetaCount, iExtraPadding: integer;
  BufferName, sTmp: string;
  MetaDataBlockHeader: array[1..4] of byte;
  oldHeader:  TFlacHeader;
  MetaBlocks: TMemoryStream;
  bRebuild, bRearange: boolean;
begin

  Result    := False;
  bRearange := False;
  iExtraPadding := 0;
  if (not FileExists(sFile)) or (FileSetAttr(sFile, 0) <> 0) then
    exit;

  try
    iFileAge := 0;
    if bTAG_PreserveDate then
      iFileAge := FileAge(sFile);

    // re arrange other metadata in case of
    // 1. padding block is not aligned after vorbis comment
    // 2. insufficient padding - rearange upon file rebuild
    // 3. fragmented padding blocks
    iMetaCount := Length(aMetaBlockOther);
    if (FPaddingIndex <> FVorbisIndex + 1) or (FPadding <=
      VorbisBlock.Size - FTagSize) or FPaddingFragments then
      begin
      MetaBlocks := TMemoryStream.Create;
      for i := 0 to iMetaCount - 1 do
        begin
        aMetaBlockOther[i].MetaDataBlockHeader[1] :=
          (aMetaBlockOther[i].MetaDataBlockHeader[1] and $7f); // not last

        if aMetaBlockOther[i].MetaDataBlockHeader[1] = META_PADDING then
          begin
          iExtraPadding := iExtraPadding + aMetaBlockOther[i].Data.Size + 4;
          // add padding size plus 4 bytes of header block
          end
        else
          begin
          aMetaBlockOther[i].Data.Position := 0;
          MetaBlocks.Write(aMetaBlockOther[i].MetaDataBlockHeader[1], 4);
          MetaBlocks.CopyFrom(aMetaBlockOther[i].Data, 0);
          end;

        end;
      MetaBlocks.Position := 0;
      bRearange := True;
      end;

    // set up file
    if (FPadding <= VorbisBlock.Size - FTagSize) then
      begin // no room rebuild the file from scratch
      bRebuild    := True;
      BufferName  := sFile + '~';
      Source      := TFileStream.Create(sFile, fmOpenRead);
      // Set read-only and open old file, and create new
      Destination := TFileStream.Create(BufferName, fmCreate);
      Source.Read(oldHeader, sizeof(oldHeader));
      oldHeader.MetaDataBlockHeader[1] :=
        (oldHeader.MetaDataBlockHeader[1] and $7f); //just in case no metadata existed
      Destination.Write(oldHeader, Sizeof(oldHeader));
      Destination.CopyFrom(MetaBlocks, 0);
      end
    else
      begin
      bRebuild    := False;
      Source      := nil;
      Destination := TFileStream.Create(sFile, fmOpenWrite);
      // Set write-access and open file
      if bRearange then
        begin
        Destination.Seek(SizeOf(FHeader), soFromBeginning);
        Destination.CopyFrom(MetaBlocks, 0);
        end
      else
        begin
        Destination.Seek(FVCOffset - 4, soFromBeginning);
        end;
      end;

    // finally write vorbis block
    MetaDataBlockHeader[1] := META_VORBIS_COMMENT;
    MetaDataBlockHeader[2] := byte((VorbisBlock.Size shr 16) and 255);
    MetaDataBlockHeader[3] := byte((VorbisBlock.Size shr 8) and 255);
    MetaDataBlockHeader[4] := byte(VorbisBlock.Size and 255);
    Destination.Write(MetaDataBlockHeader[1], SizeOf(MetaDataBlockHeader));
    Destination.CopyFrom(VorbisBlock, VorbisBlock.Size);

    // and add padding
    if FPaddingLast or bRearange then
      begin
      MetaDataBlockHeader[1] := META_PADDING or $80;
      end
    else
      begin
      MetaDataBlockHeader[1] := META_PADDING;
      end;
    if bRebuild then
      begin
      iNewPadding := 4096; // why not...
      end
    else
      begin
      if FTagSize > VorbisBlock.Size then
        begin // tag got smaller increase padding
        iNewPadding := (FPadding + FTagSize - VorbisBlock.Size) + iExtraPadding;
        end
      else
        begin // tag got bigger shrink padding
        iNewPadding := (FPadding - VorbisBlock.Size + FTagSize) + iExtraPadding;
        end;
      end;
    MetaDataBlockHeader[2] := byte((iNewPadding shr 16) and 255);
    MetaDataBlockHeader[3] := byte((iNewPadding shr 8) and 255);
    MetaDataBlockHeader[4] := byte(iNewPadding and 255);
    Destination.Write(MetaDataBlockHeader[1], 4);
    if (FPadding <> iNewPadding) or bRearange then
      begin // fill the block with zeros
      sTmp := DupeString(#0, iNewPadding);
      Destination.Write(sTmp[1], iNewPadding);
      end;

    // finish
    if bRebuild then
      begin // time to put back the audio data...
      Source.Seek(FAudioOffset, soFromBeginning);
      Destination.CopyFrom(Source, Source.Size - FAudioOffset);
      Source.Free;
      Destination.Free;
      if (DeleteFile(sFile)) and (RenameFile(BufferName, sFile)) then
        begin //Replace old file and delete temporary file
        Result := True;
        end
      else
        begin
        raise Exception.Create('');
        end;
      end
    else
      begin
      Result := True;
      Destination.Free;
      end;

    // post save tasks
    if bTAG_PreserveDate then
      WideFileSetDate(sFile, iFileAge);
    if bRearange then
      FreeAndNil(MetaBlocks);

  except
    // Access error
    if FileExists(BufferName) then
      DeleteFile(BufferName);
    end;
end;

(* -------------------------------------------------------------------------- *)

function TFLACfile.DecodeUTF8(const Source: string): WideString;
var
  Index, SourceLength, FChar, NChar: cardinal;
begin
  { Convert UTF-8 to unicode }
  Result := '';
  Index  := 0;
  SourceLength := Length(Source);
  while Index < SourceLength do
    begin
    Inc(Index);
    FChar := Ord(Source[Index]);
    if FChar >= $80 then
      begin
      Inc(Index);
      if Index > SourceLength then
        exit;
      FChar := FChar and $3F;
      if (FChar and $20) <> 0 then
        begin
        FChar := FChar and $1F;
        NChar := Ord(Source[Index]);
        if (NChar and $C0) <> $80 then
          exit;
        FChar := (FChar shl 6) or (NChar and $3F);
        Inc(Index);
        if Index > SourceLength then
          exit;
        end;
      NChar := Ord(Source[Index]);
      if (NChar and $C0) <> $80 then
        exit;
      Result := Result + widechar((FChar shl 6) or (NChar and $3F));
      end
    else
      Result := Result + widechar(FChar);
    end;
end;

(* -------------------------------------------------------------------------- *)

function TFLACfile.EncodeUTF8(const Source: WideString): string;
var
  Index, SourceLength, CChar: cardinal;
begin
  { Convert unicode to UTF-8 }
  Result := '';
  Index  := 0;
  SourceLength := Length(Source);
  while Index < SourceLength do
    begin
    Inc(Index);
    CChar := cardinal(Source[Index]);
    if CChar <= $7F then
      Result := Result + Source[Index]
    else
    if CChar > $7FF then
      begin
      Result := Result + char($E0 or (CChar shr 12));
      Result := Result + char($80 or ((CChar shr 6) and $3F));
      Result := Result + char($80 or (CChar and $3F));
      end
    else
      begin
      Result := Result + char($C0 or (CChar shr 6));
      Result := Result + char($80 or (CChar and $3F));
      end;
    end;
end;

(* -------------------------------------------------------------------------- *)

end.
